home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 July / Chip_2000-07_cd.bin / sharewar / vbshpdfc / Install.exe / VB Shaped Form Creator.CAB / ReadShape.bas < prev    next >
BASIC Source File  |  2000-04-15  |  7KB  |  151 lines
  1. Attribute VB_Name = "ReadShape"
  2. 'This module is an example of how to read the .dat Data files
  3. 'saved by VBSFC version 6 to produce a region.
  4.  
  5. 'The .dat binary file format is as follows:
  6. 'The leftmost 5 bytes must be "VBSFC"
  7. '
  8. 'The next 2 bytes are the Major and Minor versions of VBSFC that wrote the file.
  9. 'The 8th and 9th bytes form an integer value specifying the largest number of points
  10. 'in any polygon.  This is handy if you want to define an array to hold polygon points
  11. 'and don't want to have to resize it.
  12. '
  13. 'Subsequent bytes (10 and onwards) follow the fixed format:
  14. 'ObjectType,Top,Left,Right,Bottom,RoundedRectX,RoundedRectY,CombinationMethod
  15. 'Where ObjectType and CombinationMethod are single bytes and all the other are double
  16. 'bytes (integers).  ObjectType and CombinationMethod values are defined in the Enum
  17. 'structures below for ObjectTypes and Methods.  If any property is not used it
  18. 'is 0, and still takes up the same 2 bytes, so each record is of the same length.
  19. '
  20. 'In the case of a polygon object type the fixed length object bytes are followed by
  21. 'an integer which specifies the length (in integers, so double this number of bytes)
  22. 'of a variable length section containing integer points in the polygon, X followed by Y.
  23. 'For polygons the Top property specifies Winding or Alternate fill.
  24.  
  25.  
  26. Option Explicit
  27. Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
  28. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  29. Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  30. Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  31. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  32. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  33. Private Type POINTAPI
  34.    X As Long
  35.    Y As Long
  36. End Type
  37. Private Const RGN_AND = 1
  38. Private Const RGN_COPY = 5
  39. Private Const RGN_DIFF = 4
  40. Private Const RGN_OR = 2
  41. Private Const RGN_XOR = 3
  42.  
  43. Public Enum ObjectTypes
  44.     Rectangle = 0
  45.     Polygon = 1
  46.     RoundedRectangle = 2
  47.     Ellipse = 3
  48. End Enum
  49. Public Enum Methods
  50.     ANDCombine = 0
  51.     ORCombine = 1
  52.     XORCombine = 2
  53.     NOTCombine = 3
  54. End Enum
  55. Public Function ReadFormRegion(FileName As String) As Long
  56.     Dim Buffer As String, ByteBuffer As Byte, IntegerBuffer As Integer
  57.     Dim ObjectType As ObjectTypes, Top As Integer, Left As Integer, Right As Integer, Bottom As Integer, RoundedRectX As Integer, RoundedRectY As Integer, Method As Methods
  58.     Dim DObjectRegion As Long, ResultRegion As Long, HolderRegion As Long
  59.     Dim First As Boolean, Counter As Integer, PolyCount As Integer, PolyPoints() As POINTAPI
  60.     
  61.     'Open the file
  62.     Open FileName For Binary As #1
  63.     
  64.     
  65.     Buffer = "*****"    'Read 5 bytes
  66.     Get #1, , Buffer
  67.     
  68.     'Check for validity
  69.     If Buffer <> "VBSFC" Then
  70.         MsgBox FileName + " is not a valid data file.", vbOKOnly Or vbCritical, "VB Shaped Form Creator"
  71.         Close #1
  72.         Exit Function
  73.     End If
  74.     
  75.     'Create Polygon Points buffer
  76.     Seek #1, 8
  77.     Get #1, , IntegerBuffer
  78.     ReDim PolyPoints(0 To IntegerBuffer - 1) As POINTAPI
  79.     
  80.     ResultRegion = CreateRectRgn(0, 0, 0, 0)
  81.     HolderRegion = CreateRectRgn(0, 0, 0, 0)
  82.     First = True
  83.     Do
  84.         Get #1, , ByteBuffer: ObjectType = ByteBuffer
  85.         Get #1, , IntegerBuffer: Top = IntegerBuffer
  86.         Get #1, , IntegerBuffer: Left = IntegerBuffer
  87.         Get #1, , IntegerBuffer: Right = IntegerBuffer
  88.         Get #1, , IntegerBuffer: Bottom = IntegerBuffer
  89.         Get #1, , IntegerBuffer: RoundedRectX = IntegerBuffer
  90.         Get #1, , IntegerBuffer: RoundedRectY = IntegerBuffer
  91.         Get #1, , ByteBuffer: Method = ByteBuffer
  92.         Select Case ObjectType
  93.         Case Rectangle
  94.             DObjectRegion = CreateRectRgn(Left, Top, Right, Bottom)
  95.             If First Then
  96.                 First = False
  97.                 CombineRgn ResultRegion, DObjectRegion, DObjectRegion, RGN_COPY
  98.             Else
  99.                 CombineRgn HolderRegion, ResultRegion, ResultRegion, RGN_COPY
  100.                 CombineRgn ResultRegion, HolderRegion, DObjectRegion, Method + 1
  101.             End If
  102.             DeleteObject DObjectRegion
  103.         Case Polygon
  104.             Get #1, , PolyCount
  105.             If PolyCount > 0 Then
  106.                 For Counter = 0 To PolyCount - 1
  107.                     Get #1, , IntegerBuffer: PolyPoints(Counter).X = IntegerBuffer
  108.                     Get #1, , IntegerBuffer: PolyPoints(Counter).Y = IntegerBuffer
  109.                 Next Counter
  110.                 DObjectRegion = CreatePolygonRgn(PolyPoints(0), PolyCount, Top)
  111.                 If First Then
  112.                     First = False
  113.                     CombineRgn ResultRegion, DObjectRegion, DObjectRegion, RGN_COPY
  114.                 Else
  115.                     CombineRgn HolderRegion, ResultRegion, ResultRegion, RGN_COPY
  116.                     CombineRgn ResultRegion, HolderRegion, DObjectRegion, Method + 1
  117.                 End If
  118.                 DeleteObject DObjectRegion
  119.             End If
  120.         Case RoundedRectangle
  121.             DObjectRegion = CreateRoundRectRgn(Left, Top, Right, Bottom, RoundedRectX * 2, RoundedRectY * 2)
  122.             If First Then
  123.                 First = False
  124.                 CombineRgn ResultRegion, DObjectRegion, DObjectRegion, RGN_COPY
  125.             Else
  126.                 CombineRgn HolderRegion, ResultRegion, ResultRegion, RGN_COPY
  127.                 CombineRgn ResultRegion, HolderRegion, DObjectRegion, Method + 1
  128.             End If
  129.             DeleteObject DObjectRegion
  130.         Case Ellipse
  131.             DObjectRegion = CreateEllipticRgn(Left, Top, Right, Bottom)
  132.             If First Then
  133.                 First = False
  134.                 CombineRgn ResultRegion, DObjectRegion, DObjectRegion, RGN_COPY
  135.             Else
  136.                 CombineRgn HolderRegion, ResultRegion, ResultRegion, RGN_COPY
  137.                 CombineRgn ResultRegion, HolderRegion, DObjectRegion, Method + 1
  138.             End If
  139.             DeleteObject DObjectRegion
  140.         End Select
  141.     Loop Until Loc(1) = LOF(1)
  142.     Close #1
  143.     ReadFormRegion = ResultRegion
  144. End Function
  145. Private Sub colClear(col As Collection)
  146.     Dim i As Integer
  147.     For i = 1 To col.Count
  148.         col.Remove 1
  149.     Next i
  150. End Sub
  151.